package Test::Askgene::File;

use warnings;
use strict;

use Sub::Exporter -setup => {
    exports => [
        qw|file_removed_ok file_not_removed_ok fake_file_delete fake_bad_write|
    ],
    groups => {
        default => [
            qw|file_removed_ok file_not_removed_ok fake_file_delete fake_bad_write|
        ]
    }
};
use Test::Builder;
use Test::MockObject;

my $test = Test::Builder->new;

# hack so we can mock Path::Class::File::remove()
delete $Test::MockObject::{remove};

# yet another hack in order to log calls to new()
my $file = Test::MockObject->new;

$file->fake_module(
    'Path::Class::File',
    new => sub {
        shift;
        $file->dispatch_mocked_method( 'new', @_ );
        $file;
    }
);
$file->set_isa('Path::Class::File');
open( my ($fh), '>', \my ($content) );
$file->mock( 'new' => sub {$file} )->set_true(qw/remove touch stat stringify/)
    ->mock( 'open' => sub {$fh} )->mock( 'slurp' => sub {$content} );

sub fake_file_delete {
    $file->set_false('stat');
}

sub fake_bad_write {
    open( $fh, '<', \$content );
}

sub file_removed_ok {
    $test->ok( $file->call_pos(-1) eq 'remove', $_[0] || 'file removed' );
}

sub file_not_removed_ok {
    $test->ok( $file->call_pos(-1) ne 'remove', $_[0] || 'file not removed' );
}

1;
